home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / site / MIME / Base64.pm next >
Encoding:
Perl POD Document  |  1999-12-28  |  3.8 KB  |  141 lines
  1.  
  2. package MIME::Base64;
  3.  
  4. =head1 NAME
  5.  
  6. encode_base64 - Encode string using base64 encoding
  7.  
  8. decode_base64 - Decode base64 string
  9.  
  10. =head1 SYNOPSIS
  11.  
  12.  use MIME::Base64;
  13.  
  14.  $encoded = encode_base64('Aladdin:open sesame');
  15.  $decoded = decode_base64($encoded);
  16.  
  17. =head1 DESCRIPTION
  18.  
  19. This module provides functions to encode and decode strings into the
  20. Base64 encoding specified in RFC 2045 - I<MIME (Multipurpose Internet
  21. Mail Extensions)>. The Base64 encoding is designed to represent
  22. arbitrary sequences of octets in a form that need not be humanly
  23. readable. A 65-character subset ([A-Za-z0-9+/=]) of US-ASCII is used,
  24. enabling 6 bits to be represented per printable character.
  25.  
  26. The following functions are provided:
  27.  
  28. =over 4
  29.  
  30. =item encode_base64($str, [$eol])
  31.  
  32. Encode data by calling the encode_base64() function.  The first
  33. argument is the string to encode.  The second argument is the line
  34. ending sequence to use (it is optional and defaults to C<"\n">).  The
  35. returned encoded string is broken into lines of no more than 76
  36. characters each and it will end with $eol unless it is empty.  Pass an
  37. empty string as second argument if you do not want the encoded string
  38. broken into lines.
  39.  
  40. =item decode_base64($str)
  41.  
  42. Decode a base64 string by calling the decode_base64() function.  This
  43. function takes a single argument which is the string to decode and
  44. returns the decoded data.  Any character not part of the legal base64
  45. chars is ignored.
  46.  
  47. =back
  48.  
  49. If you prefer not to import these routines into your namespace you can
  50. call them as:
  51.  
  52.     use MIME::Base64 ();
  53.     $encoded = MIME::Base64::encode($decoded);
  54.     $decoded = MIME::Base64::decode($encoded);
  55.  
  56.  
  57. =head1 COPYRIGHT
  58.  
  59. Copyright 1995-1997 Gisle Aas.
  60.  
  61. This library is free software; you can redistribute it and/or
  62. modify it under the same terms as Perl itself.
  63.  
  64. Distantly based on LWP::Base64 written by Martijn Koster
  65. <m.koster@nexor.co.uk> and Joerg Reichelt <j.reichelt@nexor.co.uk> and
  66. code posted to comp.lang.perl <3pd2lp$6gf@wsinti07.win.tue.nl> by Hans
  67. Mulder <hansm@wsinti07.win.tue.nl>
  68.  
  69. The XS implementation use code from metamail.  Copyright 1991 Bell
  70. Communications Research, Inc. (Bellcore)
  71.  
  72. =cut
  73.  
  74. use strict;
  75. use vars qw(@ISA @EXPORT $VERSION $OLD_CODE);
  76.  
  77. require Exporter;
  78. require DynaLoader;
  79. @ISA = qw(Exporter DynaLoader);
  80. @EXPORT = qw(encode_base64 decode_base64);
  81.  
  82. $VERSION = '2.03';
  83.  
  84. eval { bootstrap MIME::Base64 $VERSION; };
  85. if ($@) {
  86.     *encode_base64 = \&old_encode_base64;
  87.     *decode_base64 = \&old_decode_base64;
  88.  
  89.     $OLD_CODE = $@;
  90. }
  91.  
  92.  
  93. use integer;
  94.  
  95. sub old_encode_base64 ($;$)
  96. {
  97.     my $res = "";
  98.     my $eol = $_[1];
  99.     $eol = "\n" unless defined $eol;
  100.     pos($_[0]) = 0;                          # ensure start at the beginning
  101.     while ($_[0] =~ /(.{1,45})/gs) {
  102.     $res .= substr(pack('u', $1), 1);
  103.     chop($res);
  104.     }
  105.     $res =~ tr|` -_|AA-Za-z0-9+/|;               # `# help emacs
  106.     my $padding = (3 - length($_[0]) % 3) % 3;
  107.     $res =~ s/.{$padding}$/'=' x $padding/e if $padding;
  108.     if (length $eol) {
  109.     $res =~ s/(.{1,76})/$1$eol/g;
  110.     }
  111.     $res;
  112. }
  113.  
  114.  
  115. sub old_decode_base64 ($)
  116. {
  117.     local($^W) = 0; # unpack("u",...) gives bogus warning in 5.00[123]
  118.  
  119.     my $str = shift;
  120.     my $res = "";
  121.  
  122.     $str =~ tr|A-Za-z0-9+=/||cd;            # remove non-base64 chars
  123.     if (length($str) % 4) {
  124.     require Carp;
  125.     Carp::croak("Base64 decoder requires string length to be a multiple of 4")
  126.     }
  127.     $str =~ s/=+$//;                        # remove padding
  128.     $str =~ tr|A-Za-z0-9+/| -_|;            # convert to uuencoded format
  129.     while ($str =~ /(.{1,60})/gs) {
  130.     my $len = chr(32 + length($1)*3/4); # compute length byte
  131.     $res .= unpack("u", $len . $1 );    # uudecode
  132.     }
  133.     $res;
  134. }
  135.  
  136.  
  137. *encode = \&encode_base64;
  138. *decode = \&decode_base64;
  139.  
  140. 1;
  141.